home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1997 July: Mac OS SDK / Dev.CD Jul 97 SDK2.toast / Development Kits (Disc 2) / ScriptX / Code Samples / untested / tcpip / web / http.sx < prev    next >
Encoding:
Text File  |  1996-05-21  |  4.4 KB  |  202 lines  |  [TEXT/ttxt]
  1. --<<<
  2.  
  3. in module WebImplementation
  4.  
  5. -- Simple implementation of the HTTP protocol
  6.  
  7. global endOfLine := new String
  8. append endOfLine 13
  9. append endOfLine 10
  10.  
  11. function getline stream -> (
  12.     local c
  13.     local line := new String
  14.  
  15.     repeat until ((c := read stream) == 13) or (c == 10 )do append line c
  16.     if (c == 13) do
  17.       read stream
  18.  
  19.     return line
  20. )
  21.  
  22. function readAll s #key target: (new String) -> (
  23.  repeat until (isPastEnd s) do append target (read s)
  24.  target
  25. )
  26.  
  27. function readSome s #key target: (new String) -> (
  28.  for i := 1 to (readReady s) do append target (read s)
  29.  target
  30. )
  31.  
  32.  
  33. -- Connect to the server and request the specified document.
  34. -- Return a stream from which the data get can be read.
  35.  
  36. function gethttp url -> (
  37.     local file := url.path
  38.     if file = undefined do file := "/"
  39.  
  40.     local hostmachine := url.domainName
  41.     local port := url.port
  42.     -- local starttime := theeventtimestampclock.time
  43.     local s := new tcpstream host: hostmachine \
  44.             port: (if (port == undefined) then 80 else port)
  45.     -- local gotstreamtime := theeventtimestampclock.time
  46.     local line
  47.     local code
  48.     local version := "HTTP/1.0" as String
  49.     local n
  50.     local headers := new hashtable
  51.  
  52.     local req := 
  53.             "GET " \
  54.             + file \
  55.             + " " \
  56.             + version \
  57.             + endOfLine \ 
  58.             + "ACCEPT: */*" \
  59.             + endofLine \
  60.             + endOfLine
  61.  
  62.     writestring s req
  63.     
  64.     line := getLine s
  65.  
  66.     -- local gotresponsetime := theeventtimestampclock.time
  67.  
  68.     -- Check that the first three characters of this line
  69.     -- are a successful response code
  70.  
  71.     if (copyfromTo line 0 (size version)) != version do (
  72.         report (new generalexception name: "Bad protocol version") line
  73.     )
  74.     
  75.     n := size(version) + 1;
  76.     code := (copyfromto line n (3 + n)) as Integer 
  77.  
  78.     if code != 200 do (
  79.         -- This is roundabout
  80.         report (new generalexception name: "Bad response code") line
  81.     )
  82.  
  83.     -- Process the headers
  84.     -- until blankline
  85.     -- Does not deal with multiline headers
  86.  
  87.     repeat until (line := getLine(s)) = "" do (
  88.         local pos := getOrdOne line (":"[1])
  89.         if (pos > 0) do (
  90.            local name := getlowercase (copyFromTo line 0 (pos - 1))
  91.            local value := copyFromTo line (1 + pos) (size line)
  92.            headers[name] := value
  93.         )
  94.     );
  95.  
  96.     -- local doneheaderstime := theeventtimestampclock.time
  97.  
  98. /*
  99.     format debug "Stream time = %*\n" \
  100.         (((gotstreamtime - starttime) as integer) / starttime.scale)
  101.  
  102.     format debug "Response time = %*\n" \
  103.         (((gotresponsetime - gotstreamtime) as integer) / starttime.scale)
  104.  
  105.     format debug "headers time = %*\n" \
  106.         (((doneheaderstime - gotresponsetime) as integer) / starttime.scale)
  107.  
  108. */
  109.  
  110.     #(headers, s)
  111. )
  112.  
  113. function posthttp url data #rest args -> (
  114.     local file := url.path
  115.     if file = undefined do file := "/"
  116.  
  117.     local hostmachine := url.domainName
  118.     local port := url.port
  119.     local s := new tcpstream host: hostmachine \
  120.             port: (if (port == undefined) then 80 else port)
  121.     local line
  122.     local code
  123.     local version := "HTTP/1.0" as String
  124.     local n
  125.     local headers := new hashtable
  126.  
  127.     print "sending"
  128.     
  129.     local req := (
  130.         "POST " +
  131.         file +
  132.         " " +
  133.         version +
  134.         endOfLine +
  135.         "ACCEPT: */*" +
  136.         endofLine +
  137.         "content-length: " +
  138.         ((size data) as String) +
  139.         endofLine +
  140.         "content-type: application/x-www-urlencoded" +    
  141.         endofLine +
  142.         endOfLine +    
  143.         data)
  144.  
  145.     writestring s req
  146.     
  147.     print "getting"
  148.  
  149.     line := getLine s
  150.  
  151.     -- local gotresponsetime := theeventtimestampclock.time
  152.  
  153.     -- Check that the first three characters of this line
  154.     -- are a successful response code
  155.  
  156.     if (copyfromTo line 0 (size version)) != version do (
  157.         report (new generalexception name: "Bad protocol version") line
  158.     )
  159.     
  160.     n := size(version) + 1;
  161.     code := (copyfromto line n (3 + n)) as Integer 
  162.  
  163.     if code != 200 do (
  164.         -- This is roundabout
  165.         report (new generalexception name: "Bad response code") line
  166.     )
  167.  
  168.     -- Process the headers
  169.     -- until blankline
  170.     -- Does not deal with multiline headers
  171.  
  172.     repeat until (line := getLine(s)) = "" do (
  173.         local pos := getOrdOne line (":"[1])
  174.         if (pos > 0) do (
  175.            local name := getlowercase (copyFromTo line 0 (pos - 1))
  176.            local value := copyFromTo line (1 + pos) (size line)
  177.            headers[name] := value
  178.         )
  179.     );
  180.  
  181.     -- local doneheaderstime := theeventtimestampclock.time
  182.  
  183. /*
  184.     format debug "Stream time = %*\n" \
  185.         (((gotstreamtime - starttime) as integer) / starttime.scale)
  186.  
  187.     format debug "Response time = %*\n" \
  188.         (((gotresponsetime - gotstreamtime) as integer) / starttime.scale)
  189.  
  190.     format debug "headers time = %*\n" \
  191.         (((doneheaderstime - gotresponsetime) as integer) / starttime.scale)
  192.  
  193. */
  194.  
  195.     #(headers, s)
  196. )
  197.  
  198. registerAccessMethod WebAccessManager "http" #(@get:gethttp,@post:posthttp)
  199.  
  200.  
  201. --->>>
  202.